home *** CD-ROM | disk | FTP | other *** search
/ Shareware Extravaganza - Disc 4 / Shareware Extravaganza - Over 25,000 Programs (The Ultimate Shareware Company)(Disc 4 of 4)(1993).iso / cad / autohtch.zip / HTCH.LSP < prev   
Text File  |  1990-03-30  |  2KB  |  95 lines
  1. (Defun UPDATESET (/ mod sset2 sset2ct)
  2.    (setq mod nil)
  3.    (initget 1 "Y N")
  4.    (setq mod
  5.      (getkword "\nSelect more? <Y N> "))
  6.    (if (= mod "Y") (setq sset2 (ssget)))
  7.     (if (ssname sset2 0)
  8.      (progn
  9.        (setq sset2ct 0)
  10.         (while (<= sset2ct (sslength sset2))
  11.          (if (ssname sset2 sset2ct)
  12.                (ssadd (ssname sset2 sset2ct) sset1))
  13.          (setq sset2ct (1+ sset2ct))
  14.         )
  15.      )
  16.    )
  17. )
  18.  
  19. (defun BREAKUP (/ counter brk frst scnd)
  20.   (setq counter 0)
  21.   (while (< counter (sslength sset1))
  22.     (redraw (ssname sset1 counter) 3)
  23.     (setq counter (1+ counter))
  24.   )
  25.  (initget 1 "Y N")
  26.  (setq brk (getkword "\Need to Break any lines? <Y N> "))
  27.   (if (= brk "Y")
  28.      (progn
  29.       (while brk
  30.        (setq brk (entsel "\nSelect line/arc to break: "))
  31.         (if brk
  32.           (progn
  33.              (if (ssmemb (car brk) sset1)
  34.                    (setq sset1 (ssdel (car brk) sset1)))
  35.              (redraw (car brk) 1)
  36.              (setq frst
  37.               (getpoint "\nSelect point to break at: ")
  38.                    secnd
  39.               (getpoint "\nSelect point to break to: "))
  40.              (command
  41.              "break" (cadr brk) "f" frst secnd) ) ) )
  42.              (updateset)
  43.              )
  44.             )
  45.            )
  46.  
  47. (defun GETSET (/ reuse)
  48.   (if sset1
  49.    (progn
  50.     (setq sset2 sset1)
  51.     (initget 1 "Y N")
  52.     (setq reuse (getkword "\nRe-use selection set? <Y N> "))
  53.      (if (= reuse "N") (setq sset1 (ssget)))
  54.    )
  55.   (setq sset1 (ssget))
  56.  )
  57. )
  58.  
  59. (setq sset1 nil)
  60.  
  61. (Defun C:HTCH (/ layersav)
  62.  (setvar "cmdecho" 0)
  63.  (if (not pat) (setq pat "ANSI31"))
  64.  (if (not sc) (setq sc 1.0))
  65.  (if (not an) (setq an 0.0))
  66.  (setq pat (input_txt "\nHatch Pattern: " pat)
  67.        sc  (input_real "\nHatch Scale: " sc)
  68.        an  (input_real "\nHatch Angle: " an)
  69.        layersav (getvar "clayer"))
  70.  (getset)
  71.  (breakup)
  72.  (command "layer" "S" "0" "")
  73.  (if sset1 (command "hatch" pat sc an sset1 ""))
  74.  (command "layer" "S" layersav "")
  75.  (princ)
  76. )
  77.  
  78. (Defun INPUT_REAL (A B / C)
  79.  (setq A (strcat A " <" (rtos B 2 3) ">: "))
  80.  (setq C (getdist A))
  81.  (if (/= C nil)
  82.   (setq B C)
  83.   (setq B B)
  84.  )
  85. )
  86.  
  87. (Defun INPUT_TXT (A B / C)
  88.  (setq A (strcat A " <" B ">: "))
  89.  (setq C (getstring A))
  90.  (if (/= C "")
  91.   (setq B C)
  92.   (setq B B)
  93.  )
  94. )
  95.